home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / opbonus.arc / CACHE.ARC / PKCACHE.PAS < prev   
Pascal/Delphi Source File  |  1991-03-20  |  11KB  |  330 lines
  1. unit PkCache;
  2.  
  3. (* This unit contains an object derived from the picklist object in
  4.    Object Professional that includes the ability to cache item in
  5.    a memory buffer. This technique makes it possible to have a picklist
  6.    that accesses the disk or any other slow device in its ItemString
  7.    procedure and still maintain reasonable performance as the user moves
  8.    around the pick list. The constructors to the CachedPickList are
  9.    exactly like the ones in Object Professional except they take one
  10.    extra parameter that tells the picklist how many items to keep in its
  11.    buffer. An extra method FlushCache has also been added to the PickList,
  12.    call this method when updating an item to have the PickList reload
  13.    the list from the disk.
  14.  
  15.    Revision history:
  16.  
  17.     12/21/89 - First released.
  18.     08/25/90 - added storing of IType
  19.              - added overrides ItemString to provide transparent usage
  20.  
  21.    Donated to the public domain by Scott Hunter
  22. *)
  23.  
  24. interface
  25.  
  26. uses
  27.   OpRoot,
  28.   OpCrt,
  29.   OpWindow,
  30.   OpPick;
  31.  
  32. type
  33.   PickNodePtr = ^PickNode;
  34.   PickNode =
  35.     object(DoubleListNode)
  36.       pnLen    : Byte;
  37.       pnIType  : pkItemType;
  38.       pnItem   : Word;
  39.       pnText   : ^String;
  40.  
  41.       constructor Init(MaxLen : Byte);
  42.         {-Allocate space for pick node}
  43.       destructor Done; virtual;
  44.         {-Dispose of pick node}
  45.       procedure SetPickNode(Item : Word; IType : pkItemType; S : String);
  46.         {-Set pick node fields}
  47.     end;
  48.  
  49.   PickCachePtr = ^PickCache;
  50.   PickCache =
  51.     object(DoubleList)
  52.       constructor Init(CacheSize : Word; MaxLen : Byte);
  53.         {-Allocate list of CacheSize PickNodes with MaxLen lengths}
  54.       procedure TopOfCache(PNPtr : PickNodePtr);
  55.         {-Move pick node PNPtr to top of list}
  56.       procedure FlushCache;
  57.         {-Flush contents of cache}
  58.       function FindPickNode(Item : Word) : PickNodePtr;
  59.         {-Check cache for Item and return pointer to item or nil if not found}
  60.       function InCache(Item : Word; var IType : pkItemType; var IString : String) : Boolean;
  61.         {-Check cache for Item and return pointer to item or nil if not found}
  62.       procedure AddToCache(Item : Word; IType : pkItemType; IString : String);
  63.         {-Add pick list item to cache}
  64.     end;
  65.  
  66.   CachedPickListPtr = ^CachedPickList;
  67.   CachedPickList =
  68.     object(PickList)
  69.       pkCache : PickCache;
  70.       constructor Init(X1, Y1, X2, Y2 : Byte;
  71.                        ItemWidth : Byte;
  72.                        NumItems : Word;
  73.                        StringProc : pkStringProc;
  74.                        Orientation : pkGenlProc;
  75.                        CommandHandler : pkGenlProc;
  76.                        CachedItems : Word);
  77.         {-Initialize a pick window}
  78.       constructor InitCustom(X1, Y1, X2, Y2 : Byte;
  79.                              var Colors : ColorSet;
  80.                              Options : LongInt;
  81.                              ItemWidth : Byte;
  82.                              NumItems : Word;
  83.                              StringProc : pkStringProc;
  84.                              Orientation : pkGenlProc;
  85.                              CommandHandler : pkGenlProc;
  86.                              CachedItems : Word);
  87.         {-Initialize a pick window with custom window options}
  88.       constructor InitDeluxe(X1, Y1, X2, Y2 : Byte;
  89.                              var Colors : ColorSet;
  90.                              Options : LongInt;
  91.                              ItemWidth : Byte;
  92.                              NumItems : Word;
  93.                              StringProc : pkStringProc;
  94.                              Orientation : pkGenlProc;
  95.                              CommandHandler : pkGenlProc;
  96.                              PickOptions : Word;
  97.                              CachedItems : Word);
  98.         {-Initialize a pick window with custom window and pick options}
  99.       destructor Done; virtual;
  100.         {-Dispose of picklist and cache}
  101.       procedure ItemString(Item : Word;
  102.                            Mode : pkMode;
  103.                            var IType : pkItemType;
  104.                            var IString : String); virtual;
  105.         {-Supplies each item string when the list is displayed or searched}
  106.       procedure FlushCache;
  107.         {-Flush contents of cache}
  108.     end;
  109.  
  110. implementation
  111.  
  112.  
  113.   constructor PickNode.Init(MaxLen : Byte);
  114.     {-Allocate space for pick node}
  115.   begin
  116.     if (not DoubleListNode.Init) then Fail;
  117.     pnLen := MaxLen;
  118.     if (not GetMemCheck(pnText, Succ(pnLen))) then
  119.       begin
  120.         Done;
  121.         InitStatus := epFatal+ecOutOfMemory;
  122.         Fail;
  123.       end;
  124.     pnItem := 0;
  125.   end;
  126.  
  127.  
  128.   destructor PickNode.Done;
  129.     {-Dispose of pick node}
  130.   begin
  131.     FreeMemCheck(pnText, Succ(pnLen));
  132.     DoubleListNode.Done;
  133.   end;
  134.  
  135.  
  136.   procedure PickNode.SetPickNode(Item : Word; IType : pkItemType; S : String);
  137.     {-Set pick node fields}
  138.   begin
  139.     pnItem := Item;
  140.     if (Length(S) > pnLen) then S[0] := Char(pnLen);
  141.     pnText^ := S;
  142.     pnIType := IType;
  143.   end;
  144.  
  145.  
  146.   constructor PickCache.Init(CacheSize : Word; MaxLen : Byte);
  147.     {-Allocate list of CacheSize PickNodes with MaxLen lengths}
  148.   var
  149.     Node : Word;
  150.  
  151.   begin
  152.     if (not DoubleList.Init) then Fail;
  153.     for Node := 1 to CacheSize do
  154.       Append(New(PickNodePtr, Init(MaxLen)));
  155.     if (Size <> CacheSize) then
  156.       begin
  157.         Done;
  158.         InitStatus := epFatal+ecOutOfMemory;
  159.         Fail;
  160.       end;
  161.   end;
  162.  
  163.  
  164.   procedure PickCache.TopOfCache(PNPtr : PickNodePtr);
  165.     {-Move pick node PNPtr to top of list}
  166.   begin
  167.     Remove(PNPtr);
  168.     Insert(PNPtr);
  169.   end;
  170.  
  171.  
  172.   procedure PickCache.FlushCache;
  173.     {-Flush contents of cache}
  174.   var
  175.     PNPtr : PickNodePtr;
  176.  
  177.   begin
  178.     PNPtr := PickNodePtr(Head);
  179.     while (PNPtr <> Nil) do
  180.       begin
  181.         PNPtr^.SetPickNode(0, pkNormal, '');
  182.         PNPtr := PickNodePtr(Next(PNPtr));
  183.       end;
  184.   end;
  185.  
  186.  
  187.   function PickCache.FindPickNode(Item : Word) : PickNodePtr;
  188.     {-Check cache for Item and return pointer to item or nil if not found}
  189.   var
  190.     PNPtr : PickNodePtr;
  191.  
  192.   begin
  193.     FindPickNode := Nil;
  194.     PNPtr := PickNodePtr(Head);
  195.     while (PNPtr <> Nil) and (PNPtr^.pnItem <> 0) do
  196.       begin
  197.         if (PNPtr^.pnItem = Item) then
  198.           begin
  199.             FindPickNode := PNPtr;
  200.             Exit;
  201.           end;
  202.         PNPtr := PickNodePtr(Next(PNPtr));
  203.       end;
  204.   end;
  205.  
  206.  
  207.   function PickCache.InCache(Item : Word; var IType : pkItemType; var IString : String) : Boolean;
  208.     {-Check cache for Item, if found return true and set IType and IString}
  209.   var
  210.     PNPtr : PickNodePtr;
  211.  
  212.   begin
  213.     PNPtr := FindPickNode(Item);
  214.     if (PNPtr = Nil) then
  215.       InCache := False
  216.     else
  217.       begin
  218.         InCache := True;
  219.         IString := PNPtr^.pnText^;
  220.         IType := PNPtr^.pnIType;
  221.         TopOfCache(PNPtr);
  222.       end;
  223.   end;
  224.  
  225.  
  226.   procedure PickCache.AddToCache(Item : Word; IType : pkItemType; IString : String);
  227.     {-Add pick list item to cache}
  228.   begin
  229.     PickNodePtr(Tail)^.SetPickNode(Item, IType, IString);
  230.     TopOfCache(PickNodePtr(Tail));
  231.   end;
  232.  
  233.  
  234.   constructor CachedPickList.Init(X1, Y1, X2, Y2 : Byte;
  235.                                   ItemWidth : Byte;
  236.                                   NumItems : Word;
  237.                                   StringProc : pkStringProc;
  238.                                   Orientation : pkGenlProc;
  239.                                   CommandHandler : pkGenlProc;
  240.                                   CachedItems : Word);
  241.     {-Initialize a pick window}
  242.   begin
  243.     if (not CachedPickList.InitDeluxe(X1, Y1, X2, Y2,
  244.                                      DefaultColorSet, DefWindowOptions,
  245.                                      ItemWidth, NumItems,
  246.                                      StringProc, Orientation,
  247.                                      CommandHandler, DefPickOptions,
  248.                                      CachedItems)) then
  249.       Fail;
  250.   end;
  251.  
  252.  
  253.   constructor CachedPickList.InitCustom(X1, Y1, X2, Y2 : Byte;
  254.                                         var Colors : ColorSet;
  255.                                         Options : LongInt;
  256.                                         ItemWidth : Byte;
  257.                                         NumItems : Word;
  258.                                         StringProc : pkStringProc;
  259.                                         Orientation : pkGenlProc;
  260.                                         CommandHandler : pkGenlProc;
  261.                                         CachedItems : Word);
  262.     {-Initialize a pick window with custom window options}
  263.   begin
  264.     if (not CachedPickList.InitDeluxe(X1, Y1, X2, Y2,
  265.                                     Colors, Options,
  266.                                     ItemWidth, NumItems,
  267.                                     StringProc, Orientation,
  268.                                     CommandHandler, DefPickOptions,
  269.                                     CachedItems)) then
  270.       Fail;
  271.   end;
  272.  
  273.  
  274.   constructor CachedPickList.InitDeluxe(X1, Y1, X2, Y2 : Byte;
  275.                                         var Colors : ColorSet;
  276.                                         Options : LongInt;
  277.                                         ItemWidth : Byte;
  278.                                         NumItems : Word;
  279.                                         StringProc : pkStringProc;
  280.                                         Orientation : pkGenlProc;
  281.                                         CommandHandler : pkGenlProc;
  282.                                         PickOptions : Word;
  283.                                         CachedItems : Word);
  284.     {-Initialize a pick window with custom window and pick options}
  285.   begin
  286.     if (not PickList.InitDeluxe(X1, Y1, X2, Y2, Colors, Options, ItemWidth,
  287.                                NumItems, StringProc, Orientation,
  288.                                CommandHandler, PickOptions)) then
  289.       Fail;
  290.     if (not pkCache.Init(CachedItems, ItemWidth)) then
  291.       begin
  292.         PickList.Done;
  293.         Fail;
  294.       end;
  295.   end;
  296.  
  297.  
  298.   destructor CachedPickList.Done;
  299.     {-Dispose of picklist}
  300.   begin
  301.     pkCache.Done;
  302.     PickList.Done;
  303.   end;
  304.  
  305.  
  306.   procedure CachedPickList.ItemString(Item : Word;
  307.                                       Mode : pkMode;
  308.                                       var IType : pkItemType;
  309.                                       var IString : String);
  310.     {-Supplies each item string when the list is displayed or searched}
  311.   begin
  312.     if (not pkCache.InCache(Item, IType, IString)) then
  313.       begin
  314.         pkString(Item, Mode, IType, IString, @Self);
  315.         pkCache.AddToCache(Item, IType, IString);
  316.       end;
  317.   end;
  318.  
  319.  
  320.   procedure CachedPickList.FlushCache;
  321.     {-Flush contents of cache}
  322.   begin
  323.     pkCache.FlushCache;
  324.   end;
  325.  
  326.  
  327. end.
  328.  
  329.  
  330.